home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
tpxms.zip
/
XMSTEST.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
11KB
|
326 lines
Program XMSTEST;
Uses
CRT,TPXMS;
Var
handle : Word;
i : Integer;
XMSVer,
XMSRev : String;
ExtMemMove : ExtMemMoveStruct;
EMBHandle : EMBHandleStruct;
EMBAddress : Bit32Struct;
UMBSegment : UMBSegmentStruct;
Procedure GETKEY;
Var
ch : Char;
Begin
GoToXY(26,24);
Write('Press any key to continue ...');
ch := ReadKey;
If ch = #0 Then ch := Readkey
End;
Function CHKXMS : Boolean;
Begin
If NOT isXMS Then
Begin
Writeln('This program requires the following:');
Writeln(' An AT-Class or better computer (80286-80386)');
Writeln(' HIMEM.SYS successfully loaded from CONFIG.SYS');
Writeln('Program aborted.');
CHKXMS := FALSE
End
Else
CHKXMS := TRUE
End;
Function CHKVER : Boolean;
Const
NUMARY : Array[0..9] of Char = ('0','1','2','3','4','5','6','7','8','9');
Var
i : Byte;
Begin
GetVerHiMem;
If XMSResult < $0200 Then
Begin
Writeln('This program requires at least version 2.00 of HIMEM.SYS');
Writeln('Program aborted.');
CHKVER := FALSE;
Exit
End;
XMSVer := NUMARY[((Hi(XMSResult) AND $F0) SHR 4)];
If XMSVer = '0' Then XMSVer := '';
XMSVer := XMSVer + NUMARY[(Hi(XMSResult) AND $0F)] + '.';
XMSVer := XMSVer + NUMARY[((Lo(XMSResult) AND $F0) SHR 4)];
XMSVer := XMSVer + NUMARY[(Lo(XMSResult) AND $0F)];
GetRevHiMem;
XMSRev := NUMARY[((Hi(XMSResult) AND $F0) SHR 4)];
If XMSRev = '0' Then XMSRev := '';
XMSRev := XMSRev + NUMARY[(Hi(XMSResult) AND $0F)] + '.';
XMSRev := XMSRev + NUMARY[((Lo(XMSResult) AND $F0) SHR 4)];
XMSRev := XMSRev + NUMARY[(Lo(XMSResult) AND $0F)];
CHKVER := TRUE
End;
Function CHKHMA : Boolean;
Begin
GetMemHMA($FFFF);
If XMSResult <> 1 Then
Begin
Writeln('This program requires that the High Memory Area is clear.');
Writeln('Try rebooting the system and running this program again.');
Writeln('Program aborted.');
CHKHMA := FALSE
End
Else
Begin
FreeMemHMA;
CHKHMA := TRUE
End
End;
Function CHKEXT : Boolean;
Begin
QueryFreeMemXMS;
If XMSResult < 4 Then
Begin
Writeln('This program requires that the Extended Memory Area have');
Writeln('at least 4096 bytes free. You may not have enough memory');
Writeln('in your system or you need to deallocate some memory from');
Writeln('your RAM DISK or DISK CACHE. Please note that HIMEM.SYS is');
Writeln('incompatible with VDISK.SYS in versions of DOS below 4.00.');
Writeln('The RAMDRIVE program included with Windows/286/386 will work.');
Writeln('Program aborted.');
CHKEXT := FALSE
End
Else
CHKEXT := TRUE
End;
Procedure TITLESCR;
Begin
ClrScr;
GoToXY(19, 2);
Write('XMSTEST v1.00 Written by Vernon E. Davis');
GoToXY(19, 4);
Write('Source Code for Turbo Pascal v4.x and above');
GoToXY(31, 7);
Write('XMS Version : ',XMSVer);
GoToXY(31, 9);
Write('XMS Revision : ',XMSRev);
GoToXY( 7,12);
Write('This program will perform tests on HIMEM.SYS, the Extended Memory');
GoToXY( 7,13);
Write('Manager for AT-Class and above machines. All functions implemented');
GoToXY( 7,14);
Write('are current as of Revision Level 2.06 of HIMEM.SYS, dated 03/21/89.');
GoToXY( 7,15);
Write('Some of the functions allocated in this revision are not functional');
GoToXY( 7,16);
Write('( See the .DOC file for a list of these functions ). If you have');
GoToXY( 7,17);
Write('gotten this far, you have at least 4096 bytes free of Extended');
GoToXY( 7,18);
Write('Memory and the High Memory Address area is clear. This program will');
GoToXY( 7,19);
Write('provide an idea of how to write code for utilizing the HMA and XMS');
GoToXY( 7,20);
Write('functions provided by HIMEM.SYS. All code in the TPXMS Unit is Pascal');
GoToXY( 7,21);
Write('with Inline function calls to the XMM_Control routine. Studying this');
GoToXY( 7,22);
Write('test program will enable you to take full advantage of HIMEM.SYS.');
GoToXY(28,24);
GETKEY
End;
Procedure TSTA20;
Function STATA20 : String;
Begin
QueryA20;
If XMSResult = 1 Then
STATA20 := 'A20 is enabled.'
Else
STATA20 := 'A20 is disabled.'
End;
Begin
ClrScr;
Writeln;
Writeln('This test determines if the 21st address line (A20) is usable.');
Writeln('The Global commands are used when addressing the HMA area.');
Writeln('The Local commands are used when addressing Extended Memory.');
Writeln('The lines below should correspond to the status of the A20 line.');
Writeln('If not, there might be a problem with the line on your system.');
Writeln('The Current status should start as "A20 is disabled".');
Writeln('If there is a problem, try rebooting the system.');
Writeln;
Writeln;
GetMemHMA($FFFF);
Writeln('Current status of A20 ... ',STATA20);
GlobalEnableA20;
Writeln('Attempting Global Enable ... ',STATA20);
GlobalDisableA20;
Writeln('Attempting Global Disable ... ',STATA20);
LocalEnableA20;
Writeln('Attempting Local Enable ... ',STATA20);
LocalDisableA20;
Writeln('Attempting Local Disable ... ',STATA20);
FreeMemHMA;
GETKEY
End;
Procedure TSTEXT;
Begin
ClrScr;
QueryFreeMemXMS;
Writeln('Total Free Extended Memory in kilobytes : ',XMSResult);
QueryFreeBlockXMS;
Writeln('Largest Block of Extended Memory in kilobytes : ',XMSResult);
Writeln;
Writeln;
Writeln('Next, we''ll test the Extended Memory Allocate and Lock Functions.');
Writeln('The two numbers above indicate the total Extended Memory and the');
Writeln('largest available block, respectively. Now we''ll allocate 4096');
Writeln('bytes (4KB) of memory for our test.');
GETKEY;
ClrScr;
handle := AllocExtMemBlockXMS(4);
QueryFreeMemXMS;
Writeln('Total Free Extended Memory in kilobytes : ',XMSResult);
QueryFreeBlockXMS;
Writeln('Largest Block of Extended Memory in kilobytes : ',XMSResult);
Writeln;
Writeln;
EMBHandleInfoXMS(handle,EMBHandle);
With EMBHandle Do
Begin
Writeln('Extended Memory Block Information:');
Writeln;
Writeln('Lock Count : ',LockCount);
Writeln('Free Handles : ',FreeHandles);
Writeln('Block Length in Kilobytes : ',BlockLenKB)
End;
Writeln;
Writeln;
Writeln('The "Total Free" and "Largest Block" numbers have decreased by 4');
Writeln('as we allocated 4 kilobytes for our test. The block allocated has');
Writeln('the 4 kilobytes as displayed in the "Block Length" information.');
Writeln('Also, the number of free Extended Memory handles has decreased by');
Writeln('one and the Lock Count is zero because we have not locked the block');
Writeln('yet. Let''s now lock the block.');
GETKEY;
ClrScr;
EMBAddress := LockExtMemBlockXMS(handle);
QueryFreeMemXMS;
Writeln('Total Free Extended Memory in kilobytes : ',XMSResult);
QueryFreeBlockXMS;
Writeln('Largest Block of Extended Memory in kilobytes : ',XMSResult);
Writeln;
Writeln;
EMBHandleInfoXMS(handle,EMBHandle);
With EMBHandle Do
Begin
Writeln('Extended Memory Block Information:');
Writeln;
Writeln('Lock Count : ',LockCount);
Writeln('Free Handles : ',FreeHandles);
Writeln('Block Length in Kilobytes : ',BlockLenKB);
Writeln('Block Address : ',EMBAddress)
End;
UnlockExtMemBlockXMS(handle);
FreeExtMemBlockXMS(handle);
Writeln;
Writeln;
Writeln('Now notice that the Lock Count has increased by one. Also note');
Writeln('the Block Address. This is shown for curiosity only. Remember');
Writeln('that since this address is a 32-bit unsigned number, and it is');
Writeln('stored in Turbo Pascal as a LongInt, which is a 32-bit SIGNED');
Writeln('number, its value may or may not be actually true ( See the .DOC');
Writeln('file for further information ).');
GETKEY
End;
Procedure TSTMOV;
Begin
ClrScr;
GoToXY( 5, 9);
Writeln('Next, we''ll test the Extended Memory Move Function. This function is');
GoToXY( 5,10);
Writeln('called with a pointer to a structure which contains the length in bytes');
GoToXY( 5,11);
Writeln('to move, the Handles of the Source and Destination and the addresses of');
GoToXY( 5,12);
Writeln('the Source and Destination. We''ll write 1999 letter "A"s to the screen');
GoToXY( 5,13);
Writeln('and save them to Extended Memory. Then we''ll clear the screen and move');
GoToXY( 5,14);
Writeln('them back to the screen.');
GETKEY;
handle := AllocExtMemBlockXMS(4);
EMBAddress := LockExtMemBlockXMS(handle);
With ExtMemMove Do
Begin
Length := 4000;
SourceHandle := 0;
If LastMode = 7 then SourceOffset := $B0000000 else SourceOffset :=
$B8000000 ;
DestHandle := handle;
DestOffset := 0
End;
GoToXY(1,1);
For i := 1 To 1999 Do Write('A');
GETKEY;
MoveExtMemBlockXMS(ExtMemMove);
ClrScr;
GoToXY(20,12);
Writeln('Now, we''ll write them back from Extended Memory.');
GETKEY;
With ExtMemMove Do
Begin
Length := 4000;
SourceHandle := handle;
SourceOffset := 0;
DestHandle := 0;
If LastMode = 7 then DestOffset := $B0000000 else DestOffset :=
$B8000000
End;
MoveExtMemBlockXMS(ExtMemMove);
GETKEY;
ClrScr;
UnlockExtMemBlockXMS(handle);
FreeExtMemBlockXMS(handle)
End;
Procedure ENDSCR;
Begin
ClrScr;
GoToXY( 4, 9);
Writeln('This now concludes XMSTEST. For further information about HIMEM.SYS,');
GoToXY( 4,10);
Writeln('see the documentation included with this program. It is advisable to');
GoToXY( 4,11);
Writeln('also obtain the XMS Specification from Microsoft by either download');
GoToXY( 4,12);
Writeln('or direct from Microsoft. Thank you for your support,');
GoToXY( 4,14);
Writeln('Vernon E. Davis 07/30/89');
GETKEY;
ClrScr
End;
Begin
If NOT CHKXMS Then Halt(1);
If NOT CHKVER Then Halt(1);
If NOT CHKHMA Then Halt(1);
If NOT CHKEXT Then Halt(1);
TITLESCR;
TSTA20;
TSTEXT;
TSTMOV;
ENDSCR;
Halt(0)
End.